home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / ADA / GNAT / !gcc / adainc / 6 / ads / s-stalib < prev    next >
Text File  |  1996-02-12  |  8KB  |  168 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --              S Y S T E M . S T A N D A R D _ L I B R A R Y               --
  6. --                                                                          --
  7. --                                 S p e c                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.19 $                             --
  10. --                                                                          --
  11. --   Copyright (C) 1992,1993,1994,1995,1996 Free Software Foundation, Inc.  --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22. -- MA 02111-1307, USA.                                                      --
  23. --                                                                          --
  24. -- As a special exception,  if other files  instantiate  generics from this --
  25. -- unit, or you link  this unit with other files  to produce an executable, --
  26. -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27. -- covered  by the  GNU  General  Public  License.  This exception does not --
  28. -- however invalidate  any other reasons why  the executable file  might be --
  29. -- covered by the  GNU Public License.                                      --
  30. --                                                                          --
  31. -- GNAT was originally developed  by the GNAT team at  New York University. --
  32. -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  33. --                                                                          --
  34. ------------------------------------------------------------------------------
  35.  
  36. --  This package is included in all programs. It contains references to the
  37. --  set of packages that are required to be part of every Ada program. A
  38. --  special mechanism is required to ensure that these are loaded, since it
  39. --  may be the case in some programs that the only references to these
  40. --  required packages are from C code or from code generated directly by
  41. --  Gigi, an in both cases the binder is not aware of such references.
  42.  
  43. --  System.Standard_Library also includes data that must be present in every
  44. --  program, in particular the definitions of all the standard and also some
  45. --  subprograms that must be present in every program.
  46.  
  47. --  The binder unconditionally includes s-stalib.ali, which ensures that this
  48. --  package and the packages it references are included in all Ada programs,
  49. --  together with the included data.
  50.  
  51. with System;
  52. with Unchecked_Conversion;
  53.  
  54. package System.Standard_Library is
  55.  
  56.    -------------------------------------
  57.    -- Exception Declarations and Data --
  58.    -------------------------------------
  59.  
  60.    Exception_Msg_Max : constant := 200;
  61.    --  Maximum length of message in exception occurrence
  62.  
  63.    subtype Exception_Message_Buffer is String (1 .. 200);
  64.    --  The Task specific buffer for exception messages. This buffer is used
  65.    --  for holding non-huge messages during the popping of the primary
  66.    --  stack. For bigger messages, dynamic allocation is used.
  67.  
  68.    type Big_String_Ptr is access all String (Positive);
  69.    --  A non-fat pointer type for exception names
  70.  
  71.    function To_Ptr is
  72.      new Unchecked_Conversion (System.Address, Big_String_Ptr);
  73.  
  74.    --  The following record defines the underlying representation of exceptions
  75.  
  76.    type Exception_Data is record
  77.       Handled_By_Others : Boolean;
  78.       C1                : Character;
  79.       C2                : Character;
  80.       C3                : Character;
  81.       Name_Length       : Natural;
  82.       Full_Name         : Big_String_Ptr;
  83.       Htable_Ptr        : Big_String_Ptr;
  84.    end record;
  85.  
  86.    --  Definitions for standard predefined exceptions defined in Standard.
  87.  
  88.    --  Why are the Nul's necessary here, seems like they should not be
  89.    --  required, since Gigi is supposed to add a Nul to each name.
  90.  
  91.    Constraint_Error_Name : constant String := "CONSTRAINT_ERROR" & Ascii.Nul;
  92.    Program_Error_Name    : constant String := "PROGRAM_ERROR"    & Ascii.Nul;
  93.    Storage_Error_Name    : constant String := "STORAGE_ERROR"    & Ascii.Nul;
  94.    Tasking_Error_Name    : constant String := "TASKING_ERROR"    & Ascii.Nul;
  95.    Abort_Signal_Name     : constant String := "_ABORT_SIGNAL"    & Ascii.Nul;
  96.  
  97.    Numeric_Error_Name    : constant String := "NUMEIC_ERROR"     & Ascii.Nul;
  98.    --  This is used only in the Ada 83 case, but it is not worth having a
  99.    --  separate version of s-stalib.ads for use in Ada 83 mode.
  100.  
  101.    Constraint_Error_Def : aliased Exception_Data :=
  102.         (Handled_By_Others => False,
  103.          C1                => 'A',
  104.          C2                => 'd',
  105.          C3                => 'a',
  106.          Name_Length       => Constraint_Error_Name'Length - 1,
  107.          Full_Name         => To_Ptr (Constraint_Error_Name'Address),
  108.          Htable_Ptr        => null);
  109.  
  110.    Numeric_Error_Def : aliased Exception_Data :=
  111.         (Handled_By_Others => False,
  112.          C1                => 'A',
  113.          C2                => 'd',
  114.          C3                => 'a',
  115.          Name_Length       => Numeric_Error_Name'Length - 1,
  116.          Full_Name         => To_Ptr (Numeric_Error_Name'Address),
  117.          Htable_Ptr        => null);
  118.  
  119.    Program_Error_Def : aliased Exception_Data :=
  120.         (Handled_By_Others => False,
  121.          C1                => 'A',
  122.          C2                => 'd',
  123.          C3                => 'a',
  124.          Name_Length       => Program_Error_Name'Length - 1,
  125.          Full_Name         => To_Ptr (Program_Error_Name'Address),
  126.          Htable_Ptr        => null);
  127.  
  128.    Storage_Error_Def : aliased Exception_Data :=
  129.         (Handled_By_Others => False,
  130.          C1                => 'A',
  131.          C2                => 'd',
  132.          C3                => 'a',
  133.          Name_Length       => Storage_Error_Name'Length - 1,
  134.          Full_Name         => To_Ptr (Storage_Error_Name'Address),
  135.          Htable_Ptr        => null);
  136.  
  137.    Tasking_Error_Def : aliased Exception_Data :=
  138.         (Handled_By_Others => False,
  139.          C1                => 'A',
  140.          C2                => 'd',
  141.          C3                => 'a',
  142.          Name_Length       => Tasking_Error_Name'Length - 1,
  143.          Full_Name         => To_Ptr (Tasking_Error_Name'Address),
  144.          Htable_Ptr        => null);
  145.  
  146.    Abort_Signal_Def : aliased Exception_Data :=
  147.         (Handled_By_Others => True,
  148.          C1                => 'A',
  149.          C2                => 'd',
  150.          C3                => 'a',
  151.          Name_Length       => Abort_Signal_Name'Length - 1,
  152.          Full_Name         => To_Ptr (Abort_Signal_Name'Address),
  153.          Htable_Ptr        => null);
  154.  
  155.    pragma Export (C, Constraint_Error_Def, "constraint_error");
  156.    pragma Export (C, Numeric_Error_Def,    "numeric_error");
  157.    pragma Export (C, Program_Error_Def,    "program_error");
  158.    pragma Export (C, Storage_Error_Def,    "storage_error");
  159.    pragma Export (C, Tasking_Error_Def,    "tasking_error");
  160.    pragma Export (C, Abort_Signal_Def,     "_abort_signal");
  161.  
  162.    procedure Abort_Undefer_Direct;
  163.    pragma Inline (Abort_Undefer_Direct);
  164.    --  A little procedure that just calls Abort_Undefer.all, for use in
  165.    --  clean up procedures, which only permit a simple subprogram name.
  166.  
  167. end System.Standard_Library;
  168.